home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Simple_Cli20339811302006.psc / Message Box / xpButton.ctl < prev    next >
Text File  |  2006-11-24  |  21KB  |  523 lines
  1. VERSION 5.00
  2. Begin VB.UserControl xpButton 
  3.    AutoRedraw      =   -1  'True
  4.    ClientHeight    =   90
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   90
  8.    DefaultCancel   =   -1  'True
  9.    EditAtDesignTime=   -1  'True
  10.    ScaleHeight     =   6
  11.    ScaleMode       =   3  'Pixel
  12.    ScaleWidth      =   6
  13.    ToolboxBitmap   =   "xpButton.ctx":0000
  14.    Begin VB.Timer OverTimer 
  15.       Enabled         =   0   'False
  16.       Interval        =   5
  17.       Left            =   0
  18.       Top             =   0
  19.    End
  20. End
  21. Attribute VB_Name = "xpButton"
  22. Attribute VB_GlobalNameSpace = False
  23. Attribute VB_Creatable = True
  24. Attribute VB_PredeclaredId = False
  25. Attribute VB_Exposed = False
  26. Attribute VB_Ext_KEY = "PropPageWizardRun" ,"Yes"
  27. Option Explicit
  28. Private Declare Function SetPixel Lib "gdi32" Alias "SetPixelV" (ByVal hDc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
  29. Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
  30. Private Declare Function SetTextColor Lib "gdi32" (ByVal hDc As Long, ByVal crColor As Long) As Long
  31. Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hDc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
  32. Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
  33. Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
  34. Private Declare Function FillRect Lib "user32" (ByVal hDc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
  35. Private Declare Function FrameRect Lib "user32" (ByVal hDc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
  36. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  37. Private Declare Function SelectObject Lib "gdi32" (ByVal hDc As Long, ByVal hObject As Long) As Long
  38. Private Declare Function MoveToEx Lib "gdi32" (ByVal hDc As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long
  39. Private Declare Function LineTo Lib "gdi32" (ByVal hDc As Long, ByVal x As Long, ByVal y As Long) As Long
  40. Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  41. Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
  42. Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
  43. Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  44. Private Declare Function InflateRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long
  45. Private Declare Function OffsetRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long
  46. Private Declare Function CopyRect Lib "user32" (lpDestRect As RECT, lpSourceRect As RECT) As Long
  47. Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
  48. Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  49. Private Type RECT
  50.     left As Long
  51.     Top As Long
  52.     Right As Long
  53.     Bottom As Long
  54. End Type
  55. Private Type POINTAPI
  56.     x As Long
  57.     y As Long
  58. End Type
  59. Private Const DT_CALCRECT = &H400
  60. Private Const DT_WORDBREAK = &H10
  61. Private Const DT_CENTER = &H1 Or DT_WORDBREAK
  62. Private Const COLOR_BTNFACE = 15
  63. Private Const COLOR_BTNTEXT = 18
  64. Private Const RGN_DIFF = 4
  65. Private Const PS_SOLID = 0
  66. Public Event Click()
  67. Public Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  68. Public Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  69. Public Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  70. Public Event KeyPress(KeyAscii As Integer)
  71. Public Event KeyDown(KeyCode As Integer, Shift As Integer)
  72. Public Event KeyUp(KeyCode As Integer, Shift As Integer)
  73. Public Event MouseOver()
  74. Public Event MouseOut()
  75. Private He As Long
  76. Private Wi As Long
  77. Private BackC As Long
  78. Private ForeC As Long
  79. Private elTex As String
  80. Private rc As RECT, rc2 As RECT, rc3 As RECT
  81. Private rgnNorm As Long
  82. Private LastButton As Byte, LastKeyDown As Byte
  83. Private isEnabled As Boolean
  84. Private hasFocus As Boolean, showFocusR As Boolean
  85. Private cFace As Long, cLight As Long, cHighLight As Long, cShadow As Long, cDarkShadow As Long, cText As Long, cTextO As Long
  86. Private lastStat As Byte, TE As String
  87. Private isOver As Boolean
  88. Private Sub OverTimer_Timer()
  89.     Dim pt As POINTAPI
  90.     GetCursorPos pt
  91.     If UserControl.hwnd <> WindowFromPoint(pt.x, pt.y) Then
  92.         OverTimer.Enabled = False
  93.         isOver = False
  94.         Call Redraw(0, True)
  95.         RaiseEvent MouseOut
  96.     End If
  97. End Sub
  98. Private Sub UserControl_AccessKeyPress(KeyAscii As Integer)
  99.     Call UserControl_Click
  100. End Sub
  101. Private Sub UserControl_Click()
  102.     If (LastButton = 1) And (isEnabled = True) Then
  103.         Call Redraw(0, True)
  104.         UserControl.Refresh
  105.         RaiseEvent Click
  106.     End If
  107. End Sub
  108. Private Sub UserControl_DblClick()
  109.     If LastButton = 1 Then
  110.         Call UserControl_MouseDown(1, 1, 1, 1)
  111.     End If
  112. End Sub
  113. Private Sub UserControl_GotFocus()
  114.     hasFocus = True
  115.     Call Redraw(lastStat, True)
  116. End Sub
  117. Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
  118.     RaiseEvent KeyDown(KeyCode, Shift)
  119.     LastKeyDown = KeyCode
  120.     If KeyCode = 32 Then
  121.         Call UserControl_MouseDown(1, 1, 1, 1)
  122.     ElseIf (KeyCode = 39) Or (KeyCode = 40) Then
  123.         SendKeys "{Tab}"
  124.     ElseIf (KeyCode = 37) Or (KeyCode = 38) Then
  125.         SendKeys "+{Tab}"
  126.     End If
  127. End Sub
  128. Private Sub UserControl_KeyPress(KeyAscii As Integer)
  129.     RaiseEvent KeyPress(KeyAscii)
  130. End Sub
  131. Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
  132.     RaiseEvent KeyUp(KeyCode, Shift)
  133.     If (KeyCode = 32) And (LastKeyDown = 32) Then
  134.         Call UserControl_MouseUp(1, 1, 1, 1)
  135.         LastButton = 1
  136.         Call UserControl_Click
  137.     End If
  138. End Sub
  139. Private Sub UserControl_LostFocus()
  140.     hasFocus = False
  141.     Call Redraw(lastStat, True)
  142. End Sub
  143. Private Sub UserControl_Initialize()
  144.     LastButton = 1
  145.     Call SetColors
  146. End Sub
  147. Private Sub UserControl_InitProperties()
  148.     isEnabled = True
  149.     showFocusR = True
  150.     elTex = Ambient.DisplayName
  151.     Set UserControl.font = Ambient.font
  152.     BackC = GetSysColor(COLOR_BTNFACE)
  153.     ForeC = GetSysColor(COLOR_BTNTEXT)
  154. End Sub
  155. Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  156.     RaiseEvent MouseDown(Button, Shift, x, y)
  157.     LastButton = Button
  158.     If Button <> 2 Then Call Redraw(2, False)
  159. End Sub
  160. Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  161.     RaiseEvent MouseMove(Button, Shift, x, y)
  162.     If Button < 2 Then
  163.         If x < 0 Or y < 0 Or x > Wi Or y > He Then
  164.             Call Redraw(0, False)
  165.         Else
  166.             If (Button = 0) And (isOver = False) Then
  167.                 OverTimer.Enabled = True
  168.                 isOver = True
  169.                 RaiseEvent MouseOver
  170.                 Call Redraw(0, True)
  171.             ElseIf Button = 1 Then
  172.                 Call Redraw(2, False)
  173.             End If
  174.         End If
  175.     End If
  176. End Sub
  177. Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  178.     RaiseEvent MouseUp(Button, Shift, x, y)
  179.     If Button <> 2 Then Call Redraw(0, False)
  180. End Sub
  181. Public Property Get Caption() As String
  182.     Caption = elTex
  183. End Property
  184. Public Property Let Caption(ByVal newValue As String)
  185.     elTex = newValue
  186.     Call SetAccessKeys
  187.     Call CalculEspaceTexte
  188.     Call Redraw(0, True)
  189.     PropertyChanged "TX"
  190. End Property
  191. Public Property Get Enabled() As Boolean
  192.     Enabled = isEnabled
  193. End Property
  194. Public Property Let Enabled(ByVal newValue As Boolean)
  195.     isEnabled = newValue
  196.     Call Redraw(0, True)
  197.     UserControl.Enabled = isEnabled
  198.     PropertyChanged "ENAB"
  199. End Property
  200. Public Property Get font() As font
  201.     Set font = UserControl.font
  202. End Property
  203. Public Property Set font(ByRef newFont As font)
  204.     Set UserControl.font = newFont
  205.     Call CalculEspaceTexte
  206.     Call Redraw(0, True)
  207.     PropertyChanged "FONT"
  208. End Property
  209. Public Property Get FontBold() As Boolean
  210.     FontBold = UserControl.FontBold
  211. End Property
  212. Public Property Let FontBold(ByVal newValue As Boolean)
  213.     UserControl.FontBold = newValue
  214.     Call CalculEspaceTexte
  215.     Call Redraw(0, True)
  216. End Property
  217. Public Property Get FontItalic() As Boolean
  218.     FontItalic = UserControl.FontItalic
  219. End Property
  220. Public Property Let FontItalic(ByVal newValue As Boolean)
  221.     UserControl.FontItalic = newValue
  222.     Call CalculEspaceTexte
  223.     Call Redraw(0, True)
  224. End Property
  225. Public Property Get FontUnderline() As Boolean
  226.     FontUnderline = UserControl.FontUnderline
  227. End Property
  228. Public Property Let FontUnderline(ByVal newValue As Boolean)
  229.     UserControl.FontUnderline = newValue
  230.     Call CalculEspaceTexte
  231.     Call Redraw(0, True)
  232. End Property
  233. Public Property Get FontSize() As Integer
  234.     FontSize = UserControl.FontSize
  235. End Property
  236. Public Property Let FontSize(ByVal newValue As Integer)
  237.     UserControl.FontSize = newValue
  238.     Call CalculEspaceTexte
  239.     Call Redraw(0, True)
  240. End Property
  241. Public Property Get FontName() As String
  242.     FontName = UserControl.FontName
  243. End Property
  244. Public Property Let FontName(ByVal newValue As String)
  245.     UserControl.FontName = newValue
  246.     Call CalculEspaceTexte
  247.     Call Redraw(0, True)
  248. End Property
  249. Public Property Get MousePointer() As MousePointerConstants
  250.     MousePointer = UserControl.MousePointer
  251. End Property
  252. Public Property Let MousePointer(ByVal newPointer As MousePointerConstants)
  253.     UserControl.MousePointer = newPointer
  254.     PropertyChanged "MPTR"
  255. End Property
  256. Public Property Get MouseIcon() As StdPicture
  257.     Set MouseIcon = UserControl.MouseIcon
  258. End Property
  259. Public Property Set MouseIcon(ByVal newIcon As StdPicture)
  260.     On Local Error Resume Next
  261.     Set UserControl.MouseIcon = newIcon
  262.     PropertyChanged "MICON"
  263. End Property
  264. Public Property Get hwnd() As Long
  265.     hwnd = UserControl.hwnd
  266. End Property
  267. Private Sub UserControl_Resize()
  268.     He = UserControl.ScaleHeight
  269.     Wi = UserControl.ScaleWidth
  270.     GetClientRect UserControl.hwnd, rc3: InflateRect rc3, -4, -4
  271.     Call CalculEspaceTexte
  272.     DeleteObject rgnNorm
  273.     Call MakeRegion
  274.     SetWindowRgn UserControl.hwnd, rgnNorm, True
  275.     If He > 0 Then Call Redraw(0, True)
  276. End Sub
  277. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  278.     With PropBag
  279.         elTex = .ReadProperty("TX", "")
  280.         isEnabled = .ReadProperty("ENAB", True)
  281.         Set UserControl.font = .ReadProperty("FONT", UserControl.font)
  282.         showFocusR = .ReadProperty("FOCUSR", True)
  283.         UserControl.MousePointer = .ReadProperty("MPTR", 0)
  284.         Set UserControl.MouseIcon = .ReadProperty("MICON", Nothing)
  285.     End With
  286.     UserControl.Enabled = isEnabled
  287.     Call SetColors
  288.     Call SetAccessKeys
  289.     Call Redraw(0, False)
  290. End Sub
  291. Private Sub UserControl_Terminate()
  292.     DeleteObject rgnNorm
  293. End Sub
  294. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  295.     With PropBag
  296.         Call .WriteProperty("TX", elTex)
  297.         Call .WriteProperty("ENAB", isEnabled)
  298.         Call .WriteProperty("FONT", UserControl.font)
  299.         Call .WriteProperty("FOCUSR", showFocusR)
  300.         Call .WriteProperty("MPTR", UserControl.MousePointer)
  301.         Call .WriteProperty("MICON", UserControl.MouseIcon)
  302.     End With
  303. End Sub
  304. Private Sub Redraw(ByVal curStat As Byte, ByVal Force As Boolean)
  305.     If Force = False Then
  306.         If (curStat = lastStat) And (TE = elTex) Then Exit Sub
  307.     End If
  308.     If He = 0 Then Exit Sub
  309.     lastStat = curStat
  310.     TE = elTex
  311.     Dim i As Long, stepXP1 As Single, XPface As Long
  312.     With UserControl
  313.         .Cls
  314.         DrawRectangle 0, 0, Wi, He, cFace
  315.         If isEnabled = True Then
  316.             'set font color
  317.             If isOver Then
  318.                 SetTextColor .hDc, cTextO
  319.             Else
  320.                 SetTextColor .hDc, cText
  321.             End If
  322.             If curStat = 0 Then
  323.                 stepXP1 = 25 / He
  324.                 XPface = ShiftColor(cFace, &H30, True)
  325.                 For i = 1 To He
  326.                     DrawLine 0, i, Wi, i, ShiftColor(XPface, -stepXP1 * i, True)
  327.                 Next
  328.                 DrawText .hDc, elTex, Len(elTex), rc, DT_CENTER
  329.                 DrawRectangle 0, 0, Wi, He, &H733C00, True
  330.                 mSetPixel 1, 1, &H7B4D10
  331.                 mSetPixel 1, He - 2, &H7B4D10
  332.                 mSetPixel Wi - 2, 1, &H7B4D10
  333.                 mSetPixel Wi - 2, He - 2, &H7B4D10
  334.                 If isOver Then
  335.                     DrawRectangle 1, 2, Wi - 2, He - 4, &H31B2FF, True
  336.                     DrawLine 2, He - 2, Wi - 2, He - 2, &H96E7&
  337.                     DrawLine 2, 1, Wi - 2, 1, &HCEF3FF
  338.                     DrawLine 1, 2, Wi - 1, 2, &H8CDBFF
  339.                     DrawLine 2, 3, 2, He - 3, &H6BCBFF
  340.                     DrawLine Wi - 3, 3, Wi - 3, He - 3, &H6BCBFF
  341.                 ElseIf ((hasFocus Or Ambient.DisplayAsDefault) And showFocusR) Then
  342.                     DrawRectangle 1, 2, Wi - 2, He - 4, &HE7AE8C, True
  343.                     DrawLine 2, He - 2, Wi - 2, He - 2, &HEF826B
  344.                     DrawLine 2, 1, Wi - 2, 1, &HFFE7CE
  345.                     DrawLine 1, 2, Wi - 1, 2, &HF7D7BD
  346.                     DrawLine 2, 3, 2, He - 3, &HF0D1B5
  347.                     DrawLine Wi - 3, 3, Wi - 3, He - 3, &HF0D1B5
  348.                 Else
  349.                     DrawLine 2, He - 2, Wi - 2, He - 2, ShiftColor(XPface, -&H30, True)
  350.                     DrawLine 1, He - 3, Wi - 2, He - 3, ShiftColor(XPface, -&H20, True)
  351.                     DrawLine Wi - 2, 2, Wi - 2, He - 2, ShiftColor(XPface, -&H24, True)
  352.                     DrawLine Wi - 3, 3, Wi - 3, He - 3, ShiftColor(XPface, -&H18, True)
  353.                     DrawLine 2, 1, Wi - 2, 1, ShiftColor(XPface, &H10, True)
  354.                     DrawLine 1, 2, Wi - 2, 2, ShiftColor(XPface, &HA, True)
  355.                     DrawLine 1, 2, 1, He - 2, ShiftColor(XPface, -&H5, True)
  356.                     DrawLine 2, 3, 2, He - 3, ShiftColor(XPface, -&HA, True)
  357.                 End If
  358.             ElseIf curStat = 2 Then
  359.                 stepXP1 = 25 / He
  360.                 XPface = ShiftColor(cFace, &H30, True)
  361.                 XPface = ShiftColor(XPface, -32, True)
  362.                 For i = 1 To He
  363.                     DrawLine 0, He - i, Wi, He - i, ShiftColor(XPface, -stepXP1 * i, True)
  364.                 Next
  365.                 SetTextColor .hDc, cText
  366.                 DrawText .hDc, elTex, Len(elTex), rc2, DT_CENTER
  367.                 DrawRectangle 0, 0, Wi, He, &H733C00, True
  368.                 mSetPixel 1, 1, &H7B4D10
  369.                 mSetPixel 1, He - 2, &H7B4D10
  370.                 mSetPixel Wi - 2, 1, &H7B4D10
  371.                 mSetPixel Wi - 2, He - 2, &H7B4D10
  372.                 DrawLine 2, He - 2, Wi - 2, He - 2, ShiftColor(XPface, &H10, True)
  373.                 DrawLine 1, He - 3, Wi - 2, He - 3, ShiftColor(XPface, &HA, True)
  374.                 DrawLine Wi - 2, 2, Wi - 2, He - 2, ShiftColor(XPface, &H5, True)
  375.                 DrawLine Wi - 3, 3, Wi - 3, He - 3, XPface
  376.                 DrawLine 2, 1, Wi - 2, 1, ShiftColor(XPface, -&H20, True)
  377.                 DrawLine 1, 2, Wi - 2, 2, ShiftColor(XPface, -&H18, True)
  378.                 DrawLine 1, 2, 1, He - 2, ShiftColor(XPface, -&H20, True)
  379.                 DrawLine 2, 2, 2, He - 2, ShiftColor(XPface, -&H16, True)
  380.             End If
  381.         Else
  382.             XPface = ShiftColor(cFace, &H30, True)
  383.             DrawRectangle 0, 0, Wi, He, ShiftColor(XPface, -&H18, True)
  384.             SetTextColor .hDc, ShiftColor(XPface, -&H68, True)
  385.             DrawText .hDc, elTex, Len(elTex), rc, DT_CENTER
  386.             DrawRectangle 0, 0, Wi, He, ShiftColor(XPface, -&H54, True), True
  387.             mSetPixel 1, 1, ShiftColor(XPface, -&H48, True)
  388.             mSetPixel 1, He - 2, ShiftColor(XPface, -&H48, True)
  389.             mSetPixel Wi - 2, 1, ShiftColor(XPface, -&H48, True)
  390.             mSetPixel Wi - 2, He - 2, ShiftColor(XPface, -&H48, True)
  391.         End If
  392.     End With
  393. End Sub
  394. Private Sub DrawRectangle(ByVal x As Long, ByVal y As Long, ByVal Width As Long, ByVal Height As Long, ByVal color As Long, Optional OnlyBorder As Boolean = False)
  395.     Dim bRect As RECT
  396.     Dim hBrush As Long
  397.     Dim Ret As Long
  398.     bRect.left = x
  399.     bRect.Top = y
  400.     bRect.Right = x + Width
  401.     bRect.Bottom = y + Height
  402.     hBrush = CreateSolidBrush(color)
  403.     If OnlyBorder = False Then
  404.         Ret = FillRect(UserControl.hDc, bRect, hBrush)
  405.     Else
  406.         Ret = FrameRect(UserControl.hDc, bRect, hBrush)
  407.     End If
  408.     Ret = DeleteObject(hBrush)
  409. End Sub
  410. Private Sub DrawLine(ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal color As Long)
  411.     Dim pt As POINTAPI
  412.     Dim oldPen As Long, hPen As Long
  413.     With UserControl
  414.         hPen = CreatePen(PS_SOLID, 1, color)
  415.         oldPen = SelectObject(.hDc, hPen)
  416.         MoveToEx .hDc, X1, Y1, pt
  417.         LineTo .hDc, X2, Y2
  418.         SelectObject .hDc, oldPen
  419.         DeleteObject hPen
  420.     End With
  421. End Sub
  422. Private Sub mSetPixel(ByVal x As Long, ByVal y As Long, ByVal color As Long)
  423.     Call SetPixel(UserControl.hDc, x, y, color)
  424. End Sub
  425. Private Sub SetColors()
  426.     cFace = &HC0C0C0
  427.     cShadow = &H808080
  428.     cLight = &HDFDFDF
  429.     cDarkShadow = &H0
  430.     cHighLight = &HFFFFFF
  431.     cText = &H0
  432.     cTextO = cText
  433. End Sub
  434. Private Sub MakeRegion()
  435.     Dim rgn1 As Long, rgn2 As Long
  436.     DeleteObject rgnNorm
  437.     rgnNorm = CreateRectRgn(0, 0, Wi, He)
  438.     rgn2 = CreateRectRgn(0, 0, 0, 0)
  439.     rgn1 = CreateRectRgn(0, 0, 2, 1)
  440.     CombineRgn rgn2, rgnNorm, rgn1, RGN_DIFF
  441.     DeleteObject rgn1
  442.     rgn1 = CreateRectRgn(0, He, 2, He - 1)
  443.     CombineRgn rgnNorm, rgn2, rgn1, RGN_DIFF
  444.     DeleteObject rgn1
  445.     rgn1 = CreateRectRgn(Wi, 0, Wi - 2, 1)
  446.     CombineRgn rgn2, rgnNorm, rgn1, RGN_DIFF
  447.     DeleteObject rgn1
  448.     rgn1 = CreateRectRgn(Wi, He, Wi - 2, He - 1)
  449.     CombineRgn rgnNorm, rgn2, rgn1, RGN_DIFF
  450.     DeleteObject rgn1
  451.     rgn1 = CreateRectRgn(0, 1, 1, 2)
  452.     CombineRgn rgn2, rgnNorm, rgn1, RGN_DIFF
  453.     DeleteObject rgn1
  454.     rgn1 = CreateRectRgn(0, He - 1, 1, He - 2)
  455.     CombineRgn rgnNorm, rgn2, rgn1, RGN_DIFF
  456.     DeleteObject rgn1
  457.     rgn1 = CreateRectRgn(Wi, 1, Wi - 1, 2)
  458.     CombineRgn rgn2, rgnNorm, rgn1, RGN_DIFF
  459.     DeleteObject rgn1
  460.     rgn1 = CreateRectRgn(Wi, He - 1, Wi - 1, He - 2)
  461.     CombineRgn rgnNorm, rgn2, rgn1, RGN_DIFF
  462.     DeleteObject rgn1
  463.     DeleteObject rgn2
  464. End Sub
  465. Private Sub SetAccessKeys()
  466.     Dim ampersandPos As Long
  467.     If Len(elTex) > 1 Then
  468.         ampersandPos = InStr(1, elTex, "&", vbTextCompare)
  469.         If (ampersandPos < Len(elTex)) And (ampersandPos > 0) Then
  470.             If Mid$(elTex, ampersandPos + 1, 1) <> "&" Then
  471.                 UserControl.AccessKeys = LCase$(Mid$(elTex, ampersandPos + 1, 1))
  472.             Else
  473.                 ampersandPos = InStr(ampersandPos + 2, elTex, "&", vbTextCompare)
  474.                 If Mid$(elTex, ampersandPos + 1, 1) <> "&" Then
  475.                     UserControl.AccessKeys = LCase$(Mid$(elTex, ampersandPos + 1, 1))
  476.                 Else
  477.                     UserControl.AccessKeys = ""
  478.                 End If
  479.             End If
  480.         Else
  481.             UserControl.AccessKeys = ""
  482.         End If
  483.     Else
  484.         UserControl.AccessKeys = ""
  485.     End If
  486. End Sub
  487. Private Function ShiftColor(ByVal color As Long, ByVal Value As Long, Optional isXP As Boolean = False) As Long
  488.     Dim Red As Long, Blue As Long, Green As Long
  489.     If isXP = False Then
  490.         Blue = ((color \ &H10000) Mod &H100) + Value
  491.     Else
  492.         Blue = ((color \ &H10000) Mod &H100)
  493.         Blue = Blue + ((Blue * Value) \ &HC0)
  494.     End If
  495.     Green = ((color \ &H100) Mod &H100) + Value
  496.     Red = (color And &HFF) + Value
  497.     If Red < 0 Then
  498.         Red = 0
  499.     ElseIf Red > 255 Then
  500.         Red = 255
  501.     End If
  502.     If Green < 0 Then
  503.         Green = 0
  504.     ElseIf Green > 255 Then
  505.         Green = 255
  506.     End If
  507.     If Blue < 0 Then
  508.         Blue = 0
  509.     ElseIf Blue > 255 Then
  510.         Blue = 255
  511.     End If
  512.     ShiftColor = RGB(Red, Green, Blue)
  513. End Function
  514. Private Sub CalculEspaceTexte()
  515.     rc2.left = 1: rc2.Right = Wi - 2: rc2.Top = 0: rc2.Bottom = He - 2
  516.     DrawText UserControl.hDc, elTex, Len(elTex), rc2, DT_CALCRECT Or DT_WORDBREAK
  517.     CopyRect rc, rc2: OffsetRect rc, (Wi - rc.Right) \ 2, (He - rc.Bottom) \ 2
  518.     CopyRect rc2, rc: OffsetRect rc2, 1, 1
  519. End Sub
  520. Public Sub Refresh()
  521.     Call Redraw(lastStat, True)
  522. End Sub
  523.